home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / tvtool2.zip / TVAPP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-20  |  5KB  |  51 lines

  1. {*
  2. *
  3. *   Copyright (c) 1992,93 by Richard W. Hansen
  4. *
  5. *   This source code will compile.
  6. *   Full source code available to registered users.
  7. *
  8. *}
  9. (* This file was mangled by Mangler 1.10 (c) Copyright 1993 by Berend de Boer *)
  10.  UNIT TVAPP ;{$B+} {$X+} {$V-} {$I TVDEFS.INC} INTERFACE USES APP , DIALOGS , DRIVERS , OBJECTS , VIEWS ;
  11. CONST CHELPCOLOR =#$37#$3F#$3A#$13#$13#$30#$3E#$1E;CHELPBLACKWHITE =#$07#$0F#$07#$70#$70#$07#$0F#$70;
  12. CHELPMONOCHROME =#$07#$0F#$07#$70#$70#$07#$0F#$70;CCOLOR =#$CF#$7F#$70#$70#$70#$7F#$70#$78#$7E#$70#$7F+
  13. #$7F#$70#$70#$07#$70#$70#$7F#$7F#$78#$70#$07#$7F#$70+ #$70#$7F#$70#$78#$0F#$07#$0F#$78#$70#$7F#$7E#$70;
  14. CBLACKWHITE =#$8F#$7F#$70#$78#$70#$7F#$70#$78#$0F#$70#$7F+ #$7F#$70#$70#$07#$0F#$70#$07#$0F#$78#$70#$07#$7F#$70+
  15. #$70#$7F#$70#$78#$0F#$07#$0F#$78#$70#$7F#$0F#$7F;CMONOCHROME =#$8F#$7F#$70#$78#$70#$7F#$70#$78#$0F#$70#$7F+
  16. #$7F#$70#$70#$07#$0F#$70#$07#$0F#$78#$70#$07#$7F#$70+ #$70#$7F#$70#$78#$0F#$07#$0F#$78#$70#$7F#$0F#$7F;
  17. CBUSYWINDOW =#136#136#136#136#136#136#136#136;TYPE PBXBUSYWINDOW =^TBXBUSYWINDOW ;
  18. TBXBUSYWINDOW =OBJECT (TWINDOW)CONSTRUCTOR INIT (CONST AMESSAGE :STRING );FUNCTION GETPALETTE :PPALETTE ;VIRTUAL;
  19. PROCEDURE SHOW ;VIRTUAL;END ;PBXAPPLICATION =^TBXAPPLICATION ;
  20. TBXAPPLICATION =OBJECT (TAPPLICATION)MOUSEVISIBLE :BOOLEAN ;TOGGLEMOUSE :BOOLEAN ;CONSTRUCTOR INIT ;CONSTRUCTOR LOAD
  21. (VAR S :TSTREAM );PROCEDURE CLOSEALLWINDOWS ;PROCEDURE GETEVENT (VAR EVENT :TEVENT );VIRTUAL;FUNCTION GETPALETTE
  22. :PPALETTE ;VIRTUAL;PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE HIDEBUSY ;PROCEDURE SETMOUSETOGGLE
  23. (CONST ENABLE :BOOLEAN );PROCEDURE SHOWBUSY ;PROCEDURE STORE (VAR S :TSTREAM );END ;CONST BUSYWINDOW :PBXBUSYWINDOW =NIL
  24. ;PROCEDURE REGISTERTVAPP ;CONST RBXBUSYWINDOW :TSTREAMREC =(OBJTYPE :5200 ;VMTLINK :OFS (TYPEOF (TBXBUSYWINDOW )^);
  25. LOAD :@ TBXBUSYWINDOW . LOAD ;STORE :@ TBXBUSYWINDOW . STORE );CONST RBXAPPLICATION :TSTREAMREC =(OBJTYPE :5201 ;
  26. VMTLINK :OFS (TYPEOF (TBXAPPLICATION )^);LOAD :@ TBXAPPLICATION . LOAD ;STORE :@ TBXAPPLICATION . STORE );
  27. IMPLEMENTATION CONSTRUCTOR TBXBUSYWINDOW.INIT (CONST AMESSAGE:STRING );VAR OO1I:TRECT;BEGIN OO1I.ASSIGN (0 , 0 , LENGTH
  28. (AMESSAGE )+ 2 , 3 );INHERITED INIT(OO1I , '', WNNONUMBER );FLAGS := WFMOVE ;DRAGMODE := DMDRAGMOVE ;STATE := STATE AND
  29. NOT SFVISIBLE ;GETEXTENT (OO1I );OO1I.GROW (- 1 , - 1 );INSERT (NEW (PSTATICTEXT , INIT (OO1I , AMESSAGE )));END ;
  30. FUNCTION TBXBUSYWINDOW.GETPALETTE :PPALETTE ;CONST OO10:STRING [ LENGTH(CBUSYWINDOW)] =CBUSYWINDOW;BEGIN GETPALETTE := @
  31. OO10 ;END ;PROCEDURE TBXBUSYWINDOW.SHOW ;BEGIN INHERITED SHOW;MAKEFIRST ;END ;CONSTRUCTOR TBXAPPLICATION.INIT ;
  32. BEGIN INHERITED INIT;MOUSEVISIBLE := TRUE ;TOGGLEMOUSE := TRUE ;BUSYWINDOW := NEW (PBXBUSYWINDOW , INIT ('Working...'));
  33. IF (BUSYWINDOW <> NIL )THEN DESKTOP ^. INSERT (BUSYWINDOW );END ;CONSTRUCTOR TBXAPPLICATION.LOAD (VAR S:TSTREAM);
  34. BEGIN INHERITED LOAD(S );S.READ (MOUSEVISIBLE , SIZEOF (BOOLEAN ));S.READ (TOGGLEMOUSE , SIZEOF (BOOLEAN ));END ;
  35. PROCEDURE TBXAPPLICATION.CLOSEALLWINDOWS ;PROCEDURE O1l0OIl1l101 (OO10:PVIEW);FAR ;BEGIN MESSAGE (OO10 , EVCOMMAND ,
  36. CMCLOSE , NIL );END ;BEGIN DESKTOP ^. FOREACH (@ O1l0OIl1l101 );END ;PROCEDURE TBXAPPLICATION.GETEVENT
  37. (VAR EVENT:TEVENT);BEGIN INHERITED GETEVENT(EVENT );IF TOGGLEMOUSE THEN CASE EVENT.WHAT  OF EVMOUSEDOWN , EVMOUSEUP
  38. :BEGIN IF NOT MOUSEVISIBLE THEN BEGIN MOUSEVISIBLE := TRUE ;SHOWMOUSE ;END ;END ;EVMOUSEMOVE :IF NOT MOUSEVISIBLE THEN
  39. BEGIN MOUSEVISIBLE := TRUE ;SHOWMOUSE ;END ;EVKEYDOWN :IF MOUSEVISIBLE THEN BEGIN MOUSEVISIBLE := FALSE ;HIDEMOUSE ;
  40. END ;END ;END ;FUNCTION TBXAPPLICATION.GETPALETTE :PPALETTE ;CONST OO10:ARRAY [ APCOLOR.. APMONOCHROME]  OF STRING [
  41. LENGTH(CAPPCOLOR+ CHELPCOLOR+ CCOLOR)] =(CAPPCOLOR+ CHELPCOLOR+ CCOLOR, CAPPBLACKWHITE+ CHELPBLACKWHITE+ CBLACKWHITE,
  42. CAPPMONOCHROME+ CHELPMONOCHROME+ CMONOCHROME);BEGIN GETPALETTE := @ OO10 [ APPPALETTE ] ;END ;
  43. PROCEDURE TBXAPPLICATION.HANDLEEVENT (VAR EVENT:TEVENT);BEGIN INHERITED HANDLEEVENT(EVENT );CASE EVENT.WHAT  OF EVCOMMAND
  44. :CASE EVENT.COMMAND  OF CMCLOSEALL :BEGIN CLOSEALLWINDOWS ;CLEAREVENT (EVENT );END ;END ;END ;END ;
  45. PROCEDURE TBXAPPLICATION.HIDEBUSY ;BEGIN IF (BUSYWINDOW <> NIL )THEN BUSYWINDOW ^. HIDE ;END ;
  46. PROCEDURE TBXAPPLICATION.SETMOUSETOGGLE (CONST ENABLE:BOOLEAN);BEGIN IF (NOT ENABLE AND TOGGLEMOUSE )AND NOT MOUSEVISIBLE
  47. THEN BEGIN MOUSEVISIBLE := TRUE ;SHOWMOUSE ;END ;TOGGLEMOUSE := ENABLE ;END ;PROCEDURE TBXAPPLICATION.SHOWBUSY ;BEGIN IF
  48. (BUSYWINDOW <> NIL )THEN BUSYWINDOW ^. SHOW ;END ;PROCEDURE TBXAPPLICATION.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S
  49. );S.WRITE (MOUSEVISIBLE , SIZEOF (BOOLEAN ));S.WRITE (TOGGLEMOUSE , SIZEOF (BOOLEAN ));END ;PROCEDURE REGISTERTVAPP ;
  50. BEGIN REGISTERTYPE (RBXBUSYWINDOW );REGISTERTYPE (RBXAPPLICATION );END ;END .
  51.